home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 11 / CU Amiga Magazine's Super CD-ROM 11 (1997)(EMAP Images)(GB)(Track 1 of 3)[!][issue 1997-06].iso / cucd / programming / oberonv4 / source / system / amigamathl.mod (.txt) < prev    next >
Oberon Text  |  1996-06-02  |  8KB  |  210 lines
  1. Syntax20b.Scn.Fnt
  2. ParcElems
  3. Alloc
  4. Syntax24b.Scn.Fnt
  5. Syntax10.Scn.Fnt
  6. Syntax10b.Scn.Fnt
  7. Syntax14b.Scn.Fnt
  8. FoldElems
  9. (* AMIGA *)
  10. MODULE AmigaMathL; (* RD 6.8.1995, updated OJ 30 Apr 96 *)
  11. (* Danger: access to t.l1 or t.l2 must only affect adressregs!!! (Compiler-dependent) *)
  12. IMPORT
  13.     SYSTEM, E:=AmigaExec;
  14.     mathDBBase-, mathDTBase- : E.LibraryPtr;
  15.     mathDBVersion-, mathDTVersion- : INTEGER;
  16.     termEntry : E.TermEntry;
  17. CONST
  18.     mathDBName*="mathieeedoubbas.library";
  19.     mathDTName*="mathieeedoubtrans.library";
  20.     TwoLInts = RECORD
  21.         l1,l2: LONGINT
  22.     END;
  23.     t, u : TwoLInts;
  24. PROCEDURE -ReturnD0    04EH,05EH,  04EH,075H;
  25. PROCEDURE Short*(a: LONGREAL; VAR b: REAL);
  26. BEGIN
  27.     t:=SYSTEM.VAL(TwoLInts, a);
  28.     SYSTEM.PUTREG( 0, t.l1 );  SYSTEM.PUTREG( 1, t.l2 );
  29.     SYSTEM.CALL( -102, mathDTBase );
  30.     SYSTEM.GETREG( 0, b )
  31. END Short;
  32. PROCEDURE Long*(a: REAL; VAR b: LONGREAL);
  33. BEGIN
  34.     SYSTEM.PUTREG( 0, a );
  35.     SYSTEM.CALL( -108, mathDTBase );
  36.     SYSTEM.GETREG( 0, t.l1 );  SYSTEM.GETREG( 1, t.l2 );
  37.     b:=SYSTEM.VAL(LONGREAL, t)
  38. END Long;
  39. PROCEDURE Entier*(s: LONGREAL): LONGINT;
  40. BEGIN
  41.     t:=SYSTEM.VAL(TwoLInts, s);
  42.     SYSTEM.PUTREG( 0, t.l1 );  SYSTEM.PUTREG( 1, t.l2 );
  43.     SYSTEM.CALL( -90, mathDBBase );
  44.     SYSTEM.CALL( -30, mathDBBase );
  45.     ReturnD0
  46. END Entier;
  47. PROCEDURE IntToReal*(l: LONGINT; VAR d: LONGREAL);
  48. BEGIN
  49.     SYSTEM.PUTREG( 0, l );
  50.     SYSTEM.CALL( -36, mathDBBase );
  51.     SYSTEM.GETREG( 0, t.l1 );  SYSTEM.GETREG( 1, t.l2 );
  52.     d:=SYSTEM.VAL(LONGREAL, t)
  53. END IntToReal;
  54. PROCEDURE Cmp*(s1, s2: LONGREAL): LONGINT;
  55. (* 1 if s1>s2     0 if s1=s2       -1 if s1<s2 *) 
  56. BEGIN
  57.     t:=SYSTEM.VAL(TwoLInts, s1);  u:=SYSTEM.VAL(TwoLInts, s2);
  58.     SYSTEM.PUTREG( 0, t.l1 );  SYSTEM.PUTREG( 1, t.l2 );
  59.     SYSTEM.PUTREG( 2, u.l1 );  SYSTEM.PUTREG( 3,u.l2 );
  60.     SYSTEM.CALL( -42, mathDBBase );
  61.     ReturnD0
  62. END Cmp;
  63. PROCEDURE Tst*(s: LONGREAL): LONGINT;
  64. (* 1 if s>0     0 if s=0       -1 if s<0 *) 
  65. BEGIN
  66.     t:=SYSTEM.VAL(TwoLInts, s);
  67.     SYSTEM.PUTREG( 0, t.l1 );  SYSTEM.PUTREG( 1, t.l2 );
  68.     SYSTEM.CALL( -48, mathDBBase );
  69.     ReturnD0
  70. END Tst;
  71. PROCEDURE Abs*(s: LONGREAL; VAR d: LONGREAL);
  72. BEGIN
  73.     t:=SYSTEM.VAL(TwoLInts, s);
  74.     SYSTEM.PUTREG( 0, t.l1 );  SYSTEM.PUTREG( 1, t.l2 );
  75.     SYSTEM.CALL( -54, mathDBBase );
  76.     SYSTEM.GETREG( 0, t.l1 );  SYSTEM.GETREG( 1, t.l2 );
  77.     d:=SYSTEM.VAL(LONGREAL, t)
  78. END Abs;
  79. PROCEDURE Neg*(s: LONGREAL; VAR d: LONGREAL);
  80. BEGIN
  81.     t:=SYSTEM.VAL(TwoLInts, s);
  82.     SYSTEM.PUTREG( 0, t.l1 );  SYSTEM.PUTREG( 1, t.l2 );
  83.     SYSTEM.CALL( -60, mathDBBase );
  84.     SYSTEM.GETREG( 0, t.l1 );  SYSTEM.GETREG( 1, t.l2 );
  85.     d:=SYSTEM.VAL(LONGREAL, t)
  86. END Neg;
  87. PROCEDURE Add*(s1, s2: LONGREAL; VAR d: LONGREAL);
  88. BEGIN
  89.     t:=SYSTEM.VAL(TwoLInts, s1);  u:=SYSTEM.VAL(TwoLInts, s2);
  90.     SYSTEM.PUTREG( 0, t.l1 );  SYSTEM.PUTREG( 1, t.l2 );
  91.     SYSTEM.PUTREG( 2, u.l1 );  SYSTEM.PUTREG( 3,u.l2 );
  92.     SYSTEM.CALL( -66, mathDBBase );
  93.     SYSTEM.GETREG( 0, t.l1 );  SYSTEM.GETREG( 1, t.l2 );
  94.     d:=SYSTEM.VAL(LONGREAL, t)
  95. END Add;
  96. PROCEDURE Sub*(s1, s2: LONGREAL; VAR d: LONGREAL);
  97. BEGIN
  98.     t:=SYSTEM.VAL(TwoLInts, s1);  u:=SYSTEM.VAL(TwoLInts, s2);
  99.     SYSTEM.PUTREG( 0, t.l1 );  SYSTEM.PUTREG( 1, t.l2 );
  100.     SYSTEM.PUTREG( 2, u.l1 );  SYSTEM.PUTREG( 3,u.l2 );
  101.     SYSTEM.CALL( -72, mathDBBase );
  102.     SYSTEM.GETREG( 0, t.l1 );  SYSTEM.GETREG( 1, t.l2 );
  103.     d:=SYSTEM.VAL(LONGREAL, t)
  104. END Sub;
  105. PROCEDURE Mul*(s1, s2: LONGREAL; VAR d: LONGREAL);
  106. BEGIN
  107.     t:=SYSTEM.VAL(TwoLInts, s1);  u:=SYSTEM.VAL(TwoLInts, s2);
  108.     SYSTEM.PUTREG( 0, t.l1 );  SYSTEM.PUTREG( 1, t.l2 );
  109.     SYSTEM.PUTREG( 2, u.l1 );  SYSTEM.PUTREG( 3,u.l2 );
  110.     SYSTEM.CALL( -78, mathDBBase );
  111.     SYSTEM.GETREG( 0, t.l1 );  SYSTEM.GETREG( 1, t.l2 );
  112.     d:=SYSTEM.VAL(LONGREAL, t)
  113. END Mul;
  114. PROCEDURE Div*(s1, s2: LONGREAL; VAR d: LONGREAL);
  115. BEGIN
  116.     t:=SYSTEM.VAL(TwoLInts, s1);  u:=SYSTEM.VAL(TwoLInts, s2);
  117.     SYSTEM.PUTREG( 0, t.l1 );  SYSTEM.PUTREG( 1, t.l2 );
  118.     SYSTEM.PUTREG( 2, u.l1 );  SYSTEM.PUTREG( 3,u.l2 );
  119.     SYSTEM.CALL( -84, mathDBBase );
  120.     SYSTEM.GETREG( 0, t.l1 );  SYSTEM.GETREG( 1, t.l2 );
  121.     d:=SYSTEM.VAL(LONGREAL, t)
  122. END Div;
  123. (*---------------------------------------------------*)
  124. PROCEDURE Arctan*(s: LONGREAL; VAR d: LONGREAL);
  125. BEGIN
  126.     t:=SYSTEM.VAL(TwoLInts, s);
  127.     SYSTEM.PUTREG( 0, t.l1 );  SYSTEM.PUTREG( 1, t.l2 );
  128.     SYSTEM.CALL( -30, mathDTBase );
  129.     SYSTEM.GETREG( 0, t.l1 );  SYSTEM.GETREG( 1, t.l2 );
  130.     d:=SYSTEM.VAL(LONGREAL, t)
  131. END Arctan;
  132. PROCEDURE Sin*(s: LONGREAL; VAR d: LONGREAL);
  133. BEGIN
  134.     t:=SYSTEM.VAL(TwoLInts, s);
  135.     SYSTEM.PUTREG( 0, t.l1 );  SYSTEM.PUTREG( 1, t.l2 );
  136.     SYSTEM.CALL( -36, mathDTBase );
  137.     SYSTEM.GETREG( 0, t.l1 );  SYSTEM.GETREG( 1, t.l2 );
  138.     d:=SYSTEM.VAL(LONGREAL, t)
  139. END Sin;
  140. PROCEDURE Cos*(s: LONGREAL; VAR d: LONGREAL);
  141. BEGIN
  142.     t:=SYSTEM.VAL(TwoLInts, s);
  143.     SYSTEM.PUTREG( 0, t.l1 );  SYSTEM.PUTREG( 1, t.l2 );
  144.     SYSTEM.CALL( -42, mathDTBase );
  145.     SYSTEM.GETREG( 0, t.l1 );  SYSTEM.GETREG( 1, t.l2 );
  146.     d:=SYSTEM.VAL(LONGREAL, t)
  147. END Cos;
  148. PROCEDURE Exp*(s: LONGREAL; VAR d: LONGREAL);
  149. BEGIN
  150.     t:=SYSTEM.VAL(TwoLInts, s);
  151.     SYSTEM.PUTREG( 0, t.l1 );  SYSTEM.PUTREG( 1, t.l2 );
  152.     SYSTEM.CALL( -78, mathDTBase );
  153.     SYSTEM.GETREG( 0, t.l1 );  SYSTEM.GETREG( 1, t.l2 );
  154.     d:=SYSTEM.VAL(LONGREAL, t)
  155. END Exp;
  156. PROCEDURE Ln*(s: LONGREAL; VAR d: LONGREAL);
  157. BEGIN
  158.     t:=SYSTEM.VAL(TwoLInts, s);
  159.     SYSTEM.PUTREG( 0, t.l1 );  SYSTEM.PUTREG( 1, t.l2 );
  160.     SYSTEM.CALL( -84, mathDTBase );
  161.     SYSTEM.GETREG( 0, t.l1 );  SYSTEM.GETREG( 1, t.l2 );
  162.     d:=SYSTEM.VAL(LONGREAL, t)
  163. END Ln;
  164. PROCEDURE Sqrt*(s: LONGREAL; VAR d: LONGREAL);
  165. BEGIN
  166.     t:=SYSTEM.VAL(TwoLInts, s);
  167.     SYSTEM.PUTREG( 0, t.l1 );  SYSTEM.PUTREG( 1, t.l2 );
  168.     SYSTEM.CALL( -96, mathDTBase );
  169.     SYSTEM.GETREG( 0, t.l1 );  SYSTEM.GETREG( 1, t.l2 );
  170.     d:=SYSTEM.VAL(LONGREAL, t)
  171. END Sqrt;
  172. PROCEDURE Ratio*(s1, s2: LONGINT; VAR d: LONGREAL);
  173. (* returns s1/s2 *) 
  174.     VAR r1,r2: LONGREAL;
  175. BEGIN
  176.     IntToReal(s1, r1);
  177.     IntToReal(s2,r2);
  178.     Div(r1,r2,d)
  179. END Ratio;
  180. PROCEDURE e*(VAR d: LONGREAL);
  181. BEGIN
  182.     t.l1:=04005BF0AH;  t.l2:=08B14575DH;  d:=SYSTEM.VAL(LONGREAL, t)
  183. END e;
  184. PROCEDURE pi*(VAR d: LONGREAL);
  185. BEGIN
  186.     t.l1:=0400921FBH;  t.l2:=054442D10H;  d:=SYSTEM.VAL(LONGREAL, t)
  187. END pi;
  188. PROCEDURE Init;
  189. TYPE LibraryPtr=POINTER TO E.Library;
  190. VAR lib:LibraryPtr;
  191. BEGIN
  192.     mathDBBase:=E.OpenLibrary(mathDBName,37);
  193.     IF mathDBBase=0 THEN HALT(99) END;
  194.     lib:=SYSTEM.VAL(LibraryPtr,mathDBBase);
  195.     mathDBVersion:=lib.version;
  196.     mathDTBase:=E.OpenLibrary(mathDTName,37);
  197.     IF mathDTBase=0 THEN HALT(99) END;
  198.     lib:=SYSTEM.VAL(LibraryPtr,mathDTBase);
  199.     mathDTVersion:=lib.version
  200. END Init;
  201. PROCEDURE Term;
  202. BEGIN
  203.     E.CloseLibrary( mathDTBase );
  204.     E.CloseLibrary( mathDBBase )
  205. END Term;
  206. BEGIN
  207.     Init;
  208.     E.Register(termEntry, Term);
  209. END AmigaMathL.
  210.